GOAL: We wanted a better way to examine species temperature ranges based off of real data, take ranges from a distribution to combat sampling bias, a way to semi “ground truth” general distributions, and a way to inform the depth of the area of analysis. The data we have available to us are the video surveys with related temps (bottom temp of survey?).
Tip
You can click on figures in this document to see them enlarged and zoom in!
FYI: For those interested this is possible by using the lightbox Quarto extension.
I first “squinted” at the temperature data per species to determine general curves. Here are the temperature distributions for the sum of catch at half degree temperature steps per species.
To address the data richness bias here are the 10-90% percentile temp ranges. This table includes these values as well as min and max temps the species was sampled at. This data is from the video trap survey data from 2011-2018 in the U.S. South Atlantic, South of Cape Hatteras, North Carolina. While it is not the whole area we are interested in, it does at least give us an idea of temperature ranges. If we had the northern data we might be able to get better cold temperature data, but luckily we care more about the upper temperature limit.
I further explored the data to see how many data points (each point represents one individual caught at a give temperature) we were excluding using the 10-90% range. Unlabeled text are max temperature, 90% percentile temperature, 10% percentile temperature and minimum temperature respectively from top to bottom. Labels within the boxplot show the total individuals caught (Total n), samples where individuals occurred (Sample n), and the number of individuals excluded by the 10-90% range (Out n). I figured we could use this to help us refine which range we would like to use (e.g. if we were excluding large numbers of individuals maybe we should expand our range or find natural breaks).
Code
#Single instances of abundance (for jitter)vid_exp<-vid_abtemp %>%uncount(AB) %>%mutate(count=1)#Add points outside of 10-90% to show how many are outside that rangetemp_li<-list()specs<-spec_df$comfor (i in1:length(spec_df$com)) { dat<-vid_exp[vid_exp$com==specs[i],] lowup<-sa_temp[sa_temp$com==specs[i],] dat$inout<-ifelse(dat$Temp < lowup$ten_quant | dat$Temp > lowup$ninquant, "out", "in") temp_li[[i]]<-dat }inout_df<-do.call("rbind", temp_li)#Add Total n & Sampling nndf_1<-vid_abtemp %>%group_by(Species, com) %>%summarise(tot_n=sum(AB), samp_n=length(AB))ndf_2<-inout_df[inout_df$inout=="out",] %>%group_by(Species, com) %>%summarise(out_n=sum(count))n_df<-left_join(ndf_1, ndf_2)n_df$lab<-paste0("Total n=", n_df$tot_n, "\nSample n=", n_df$samp_n, "\nOut n=", n_df$out_n)#Boxplots for dataggplot(sa_temp, aes(x=com))+geom_jitter(data=inout_df[inout_df$inout=="out",], aes(y=Temp),color="gray60", alpha=0.3, width =0.4,height =0.2)+geom_boxplot(stat="identity",aes(ymin=mintemp, lower=ten_quant, middle=median,upper=ninquant, ymax=maxtemp, fill=com))+geom_text(aes(label=mintemp, y=mintemp-0.5), size=3.5, fontface="bold")+geom_text(aes(label=maxtemp, y=maxtemp+0.5), size=3.5, fontface="bold")+geom_text(aes(label=ten_quant, y=ten_quant+0.5),color="white", fontface="bold",size=3.5)+geom_text(aes(label=ninquant, y=ninquant-0.5),color="white", fontface="bold", size=3.5)+geom_label(data=n_df, aes(label=lab, y=sa_temp$median), size=2.5, fontface="bold")+labs(title ="Video Survey Temp 10-90% Quantile" , x="Species", y="Temperature")+scale_x_discrete(labels=function(x) str_wrap(x, width=10))+theme_bw()+theme(legend.position ="none",title =element_text(face="bold"))
Unlabeled text are max temperature, 90% percentile temperature, 10% percentile temperature and minimum temperature respectively from top to bottom. Labels within the boxplot show the total individuals caught (Total n), samples where individuals occurred (Sample n), and the number of individuals excluded by the 10-90% range (Out n).
Based on the above figure I explored a broader range of 5-95% and see if it was appropriate.
Code
#| fig-cap: Unlabeled text are max temperature, 90% percentile temperature, 10% percentile temperature and minimum temperature respectively from top to bottom. Labels within the boxplot show the total individuals caught (Total n), samples where individuals occurred (Sample n), and the number of individuals excluded by the 10-90% range (Out n). low_quant=0.05high_quant=0.95sa_temp_alt<-vid_abtemp %>%group_by(Species, com) %>%summarise(mintemp=round(min(Temp),2),ten_quant=round(quantile(Temp,prob =c(low_quant)),2),median=median(Temp), ninquant=round(quantile(Temp,prob =c(high_quant)),2),maxtemp=round(max(Temp),2))#Single instances of abundance (for jitter)vid_exp<-vid_abtemp %>%uncount(AB) %>%mutate(count=1)#Add points outside of 10-90% to show how many are outside that rangetemp_li<-list()specs<-spec_df$comfor (i in1:length(spec_df$com)) { dat<-vid_exp[vid_exp$com==specs[i],] lowup<-sa_temp_alt[sa_temp_alt$com==specs[i],] dat$inout<-ifelse(dat$Temp < lowup$ten_quant | dat$Temp > lowup$ninquant, "out", "in") temp_li[[i]]<-dat }inout_df<-do.call("rbind", temp_li)#Add Total n & Sampling nndf_1<-vid_abtemp %>%group_by(Species, com) %>%summarise(tot_n=sum(AB), samp_n=length(AB))ndf_2<-inout_df[inout_df$inout=="out",] %>%group_by(Species, com) %>%summarise(out_n=sum(count))n_df<-left_join(ndf_1, ndf_2)n_df$lab<-paste0("Total n=", n_df$tot_n, "\nSample n=", n_df$samp_n, "\nOut n=", n_df$out_n)#Boxplots for dataggplot(sa_temp_alt, aes(x=com))+geom_jitter(data=inout_df[inout_df$inout=="out",], aes(y=Temp),color="gray60", alpha=0.3, width =0.4,height =0.2)+geom_boxplot(stat="identity",aes(ymin=mintemp, lower=ten_quant, middle=median,upper=ninquant, ymax=maxtemp, fill=com))+geom_text(aes(label=mintemp, y=mintemp-0.5), size=3.5, fontface="bold")+geom_text(aes(label=maxtemp, y=maxtemp+0.5), size=3.5, fontface="bold")+geom_text(aes(label=ten_quant, y=ten_quant+0.5),color="white", fontface="bold",size=3.5)+geom_text(aes(label=ninquant, y=ninquant-0.5),color="white", fontface="bold", size=3.5)+geom_label(data=n_df, aes(label=lab, y=sa_temp_alt$median), size=2.5, fontface="bold")+labs(title =paste0("Video Survey Temp ",low_quant*100,"-",high_quant*100,"% Quantile") , x="Species", y="Temperature")+scale_x_discrete(labels=function(x) str_wrap(x, width=10))+theme_bw()+theme(legend.position ="none",title =element_text(face="bold"))
Lastly, I compared potential new ranges with what we had originally from a lit search.
Code
#Add old upper/lower temps to spec_dfspec_df$lowtemp=c(16,19,18.3,20.7,16.8,18.3,16.9)spec_df$hightemp=c(25.7,29,27.1,27.5,32,27.2,29)#Create df with old, 10-90%, and 5-95% quantile tempsall_temps<-data.frame(spec=spec_df$sci, com=spec_df$com,low_old=spec_df$lowtemp, upp_old=spec_df$hightemp,low_1090=sa_temp$ten_quant, upp_1090=sa_temp$ninquant,low_595=sa_temp_alt$ten_quant, upp_595=sa_temp_alt$ninquant)all_temps<-all_temps %>%mutate(comb=paste0("<b>",com, "</b><br><i>", spec,"</i>"))all_temps %>%gt(rowname_col ="comb", groupname_col =NA) %>%cols_hide(columns=c(spec, com)) %>%tab_header(title="Temperature Range Comparisons") %>%tab_spanner(.,label =md("**Old**"), columns=ends_with("_old")) %>%tab_spanner(.,label =md("**10-90%**"), columns=ends_with("_1090")) %>%tab_spanner(.,label =md("**5-95%**"), columns=ends_with("_595")) %>%cols_label(starts_with("low")~"Lower", starts_with("upp")~"Upper") %>%tab_stubhead(label="Species") %>%tab_style(style=cell_text(style ="italic"), locations =cells_body(columns = comb)) %>%tab_style(style =cell_text(color ="darkgrey", font =google_font("Source Sans Pro"), transform ="uppercase"), locations =list(cells_stubhead(), cells_column_labels())) %>%tab_style(style =cell_text(align ="center", weight ="bold"),locations =cells_title()) %>%tab_style(style =cell_borders(sides =c("right"),weight =px(2),color ="#d3d3d3"),locations =cells_body(columns =c(upp_old, upp_1090))) %>%gt_theme_nytimes() %>%fmt_markdown()
Here I explore the general distribution based on the video trap survey in the southeast. I’m not sure this is the best data we could use but again it gives a general idea.
This figure gives a smoothed heat map of density of catches. The data here are aggregated from 2011-2018. This figure is easier to use than the next one but can smooth over and hide some information.
We additionally discussed looking into the depth range of species so that we can customize our area of analysis to better represent an area that species may be able to inhabit if the bottom temperature is suitable.
I did a quick google/lit search of depth limits per species. Some were reputable sources like the fishing council and some were wiki, but I can dive deeper when we determine a game plan.
Here is the above data represented in the same way as the temperature ranges previously so we can compare among species.
Code
depth_df$com<-factor(depth_df$com, levels =unique(depth_df$com))ggplot(depth_df, aes(x=com))+geom_linerange(aes(ymin=depth_upp, ymax=depth_low), size=1.25, alpha=0.5)+geom_point(aes(y=depth_upp, fill=com), size=3, shape=21, stroke=0.9)+geom_point(aes(y=depth_low, fill=com), size=3, shape=21, stroke=0.9)+labs(y="Depth (m)", x="Species", title="Depth range of Selected Species (lit search)")+coord_flip()+scale_x_discrete(limits=rev)+theme_bw() +theme(axis.text.y =element_text(face="bold"),legend.position ="none",legend.background =element_rect(color="black"))
I looked at the depth provided from the video trap survey but examining the only depth metric they have while sampling, it appears they do not sample even close to the full range of some of these species so I don’t think we can use that data.
In order to refine the shape of our area of analysis, I tried to find shapefiles of the U.S. continental shelf. For some reason I could not find this easily. I did however find that around 140m is often where the cutoff occurs (shallow continental shelf). So instead I learned how to make my own shapefiles based on whatever depth I would like and found a really nice bathymetry tool/package that uses the ETOPO 2022 database hosted on the NOAA website.
Here is the bathymetric map of the U.S. Atlantic coast. Here I have added contour lines for 140m (general shallow continental shelf), 200m (second deepest range of our species), and 350m (deepest depth limit). I was surprised to find the area difference between these three depths is minimal.
ggsave("Bathy_Un140.png", width =6 ,height =6.5, units ="in")
Here I cut a shapefile to the 140m depth. This was the original depth I was going with before exploring the species depths but can customize once we agree on a depth.
ggsave("PolyTest.png", height =9, width =7, units ="in")
I cut the bathymetric data to the under 140m depth so that we could get a better view of the depth within our possible new area of analysis. As well as showing the orginal bathymetric map with the proposed area of analysis at 140m.